home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / screen.swg / 0030_Window Shadows.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-27  |  1.9 KB  |  66 lines
  1. {
  2. LOU DUCHEZ
  3.  
  4. > When I open the window, I want to give it a shadow, in C what you
  5. >would do is switch the 2nd bit of each character.
  6.  
  7. Shadowing here.  You'll need "Crt" for this to work:
  8. }
  9.  
  10. procedure atshadow(x1, y1, x2, y2 : byte);
  11. { Makes a "shadow" to the right of and below a screen region, by setting the
  12.   foreground there to low intensity and the background to black. }
  13. type
  14.   videolocation = record
  15.     videodata      : char;
  16.     videoattribute : byte;
  17.   end;
  18. var
  19.   xbegin, xend,
  20.   ybegin, yend,
  21.   xcnt, ycnt   : byte;
  22.   videosegment : word;
  23.   monosystem   : boolean;
  24.   vidptr       : ^videolocation;
  25.  
  26. begin
  27.   { Determine location of video memory. }
  28.   monosystem := (lastmode in [0, 2, 7]);
  29.   if monosystem then
  30.     videosegment := $b000
  31.   else
  32.     videosegment := $b800;
  33.   { Determine the x coordinates where the shadowing begins and ends on the
  34.     lower edge.  (Basically two spaces to the right of the box.) }
  35.  
  36.   xbegin := x1 + 2;
  37.   xend   := x2 + 2;
  38.  
  39.   { Determine the y coordinates where the shadowing begins and ends on the
  40.     right.  (Basically one row below the box.) }
  41.  
  42.   ybegin := y1 + 1;
  43.   yend   := y2 + 1;
  44.   ycnt   := ybegin;
  45.   while (ycnt <= yend) and (ycnt <= 25) do
  46.   begin
  47.   { This loop goes through each row, putting in the shadows on the right and
  48.     bottom.  First thing to check on each pass: if we're not below the region
  49.     to shadow, shade only to the right.  Otherwise, start at the left. }
  50.     if ycnt > y2 then
  51.       xcnt := xbegin
  52.     else
  53.       xcnt := x2 + 1;
  54.     vidptr := ptr(videosegment, 2 * (80 * (ycnt - 1) + (xcnt - 1)));
  55.     while (xcnt <= xend) and (xcnt <= 80) do
  56.     begin
  57.     { This loop does the appropriate shadowing for this row. }
  58.       vidptr^.videoattribute := vidptr^.videoattribute and $07; { SHADOW! }
  59.       xcnt := xcnt + 1;
  60.       inc(vidptr);
  61.     end;
  62.     ycnt := ycnt + 1;
  63.   end;
  64. end;
  65.  
  66.